Developer CD Series 1995 February: Tool Chest

home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 February: Tool Chest / Dev.CD Feb 95 / Dev.CD Feb 95.toast / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / User Contributions / Travers' lisp contrib.sea / Travers' lisp contrib / clos-hacks.lisp < prev next >
MacBinary | 1992-04-13 | 2.5 KB | [TEXT/CCL2]
open in:
MacOS 8.1 extracted |
Win98 extracted |
DOS extracted
browse contents |
view JSON data |
view as text

This file was processed as: MacBinary (archive/macBinary).
Confidence	Program	Detection	Match Type	Support
`10%`	dexvert	MacBinary `(archive/macBinary)`	fallback	Supported
`1%`	dexvert	Text File `(text/txt)`	fallback	Supported
`100%`	file	MacBinary II, inited, Mon Apr 13 18:26:05 1992, modified Mon Apr 13 18:26:05 1992, creator Common Lisp 2, type ASCII, 1900 bytes "clos-hacks.lisp" , at 0x7ec 441 bytes resource	default (weak)
`99%`	file	data	default
`74%`	TrID	Macintosh plain text (MacBinary)	default
`25%`	TrID	MacBinary 2	default (weak)
`100%`	siegfried	fmt/1762 MacBinary (II)	default
`100%`	lsar	MacBinary	default
id metadata
key	value
macFileType	`[TEXT]`
macFileCreator	`[CCL2]`
hex view
+--------+-------------------------+-------------------------+--------+--------+
|00000000| 00 0f 63 6c 6f 73 2d 68 | 61 63 6b 73 2e 6c 69 73 |..clos-h|acks.lis|
|00000010| 70 00 00 00 00 00 00 00 | 00 00 00 00 00 00 00 00 |p.......|........|
|00000020| 00 00 00 00 00 00 00 00 | 00 00 00 00 00 00 00 00 |........|........|
|00000030| 00 00 00 00 00 00 00 00 | 00 00 00 00 00 00 00 00 |........|........|
|00000040| 00 54 45 58 54 43 43 4c | 32 01 00 00 00 00 00 00 |.TEXTCCL|2.......|
|00000050| 00 00 00 00 00 07 6c 00 | 00 01 b9 a6 0f ba fd a6 |......l.|........|
|00000060| 0f ba fd 00 00 00 00 00 | 00 00 00 00 00 00 00 00 |........|........|
|00000070| 00 00 00 00 00 00 00 00 | 00 00 81 81 d6 72 00 00 |........|.....r..|
|00000080| 3b 3b 3b 20 43 4c 4f 53 | 20 74 6f 6f 6c 73 0d 28 |;;; CLOS| tools.(|
|00000090| 69 6e 2d 70 61 63 6b 61 | 67 65 20 3a 63 63 6c 29 |in-packa|ge :ccl)|
|000000a0| 0d 28 72 65 71 75 69 72 | 65 20 3a 6d 74 2d 75 74 |.(requir|e :mt-ut|
|000000b0| 69 6c 73 29 0d 0d 3b 3b | 3b 20 4d 43 4c 20 68 61 |ils)..;;|; MCL ha|
|000000c0| 73 20 61 64 64 2d 6d 65 | 74 68 6f 64 2c 20 62 75 |s add-me|thod, bu|
|000000d0| 74 20 64 65 66 6d 65 74 | 68 6f 64 20 64 6f 65 73 |t defmet|hod does|
|000000e0| 6e 27 74 20 75 73 65 20 | 69 74 2e 0d 0d 28 64 65 |n't use |it...(de|
|000000f0| 66 6d 65 74 68 6f 64 20 | 73 75 62 63 6c 61 73 73 |fmethod |subclass|
|00000100| 65 73 20 28 28 63 20 63 | 6c 61 73 73 29 29 0d 20 |es ((c c|lass)). |
|00000110| 20 28 72 65 6d 6f 76 65 | 2d 64 75 70 6c 69 63 61 | (remove|-duplica|
|00000120| 74 65 73 0d 20 20 20 28 | 63 6f 6e 73 20 63 20 28 |tes.   (|cons c (|
|00000130| 6d 61 70 63 61 6e 20 23 | 27 73 75 62 63 6c 61 73 |mapcan #|'subclas|
|00000140| 73 65 73 20 28 63 6c 61 | 73 73 2d 64 69 72 65 63 |ses (cla|ss-direc|
|00000150| 74 2d 73 75 62 63 6c 61 | 73 73 65 73 20 63 29 29 |t-subcla|sses c))|
|00000160| 29 29 29 0d 0d 28 64 65 | 66 6d 65 74 68 6f 64 20 |)))..(de|fmethod |
|00000170| 73 75 70 65 72 63 6c 61 | 73 73 65 73 20 28 28 63 |supercla|sses ((c|
|00000180| 20 63 6c 61 73 73 29 29 | 0d 20 20 28 72 65 6d 6f | class))|.  (remo|
|00000190| 76 65 2d 64 75 70 6c 69 | 63 61 74 65 73 0d 20 20 |ve-dupli|cates.  |
|000001a0| 20 28 63 6f 6e 73 20 63 | 20 28 6d 61 70 63 61 6e | (cons c| (mapcan|
|000001b0| 20 23 27 73 75 70 65 72 | 63 6c 61 73 73 65 73 20 | #'super|classes |
|000001c0| 28 63 6c 61 73 73 2d 64 | 69 72 65 63 74 2d 73 75 |(class-d|irect-su|
|000001d0| 70 65 72 63 6c 61 73 73 | 65 73 20 63 29 29 29 29 |perclass|es c))))|
|000001e0| 29 0d 0d 3b 3b 3b 20 54 | 68 69 73 20 6d 61 67 69 |)..;;; T|his magi|
|000001f0| 63 20 76 61 72 69 61 62 | 6c 65 20 6d 75 73 74 20 |c variab|le must |
|00000200| 62 65 20 6f 6e 20 74 6f | 20 72 65 63 6f 72 64 20 |be on to| record |
|00000210| 63 6c 61 73 73 20 2d 3e | 20 6d 65 74 68 6f 64 20 |class ->| method |
|00000220| 72 65 6c 61 74 69 6f 6e | 73 20 28 69 74 27 73 0d |relation|s (it's.|
|00000230| 3b 3b 3b 20 6e 6f 74 20 | 72 65 74 72 6f 61 63 74 |;;; not |retroact|
|00000240| 69 76 65 2c 20 65 69 74 | 68 65 72 29 2e 0d 28 73 |ive, eit|her)..(s|
|00000250| 65 74 71 20 2a 6d 61 69 | 6e 74 61 69 6e 2d 63 6c |etq *mai|ntain-cl|
|00000260| 61 73 73 2d 64 69 72 65 | 63 74 2d 6d 65 74 68 6f |ass-dire|ct-metho|
|00000270| 64 73 2a 20 74 29 0d 0d | 28 64 65 66 6d 65 74 68 |ds* t)..|(defmeth|
|00000280| 6f 64 20 63 6c 61 73 73 | 2d 6d 65 74 68 6f 64 73 |od class|-methods|
|00000290| 20 28 28 63 20 73 74 61 | 6e 64 61 72 64 2d 63 6c | ((c sta|ndard-cl|
|000002a0| 61 73 73 29 29 0d 20 20 | 28 6d 61 70 61 70 70 65 |ass)).  |(mapappe|
|000002b0| 6e 64 20 23 27 63 6c 61 | 73 73 2d 64 69 72 65 63 |nd #'cla|ss-direc|
|000002c0| 74 2d 6d 65 74 68 6f 64 | 73 20 28 73 75 70 65 72 |t-method|s (super|
|000002d0| 63 6c 61 73 73 65 73 20 | 63 29 29 29 0d 0d 28 64 |classes |c)))..(d|
|000002e0| 65 66 6d 65 74 68 6f 64 | 20 63 6c 61 73 73 2d 67 |efmethod| class-g|
|000002f0| 65 6e 65 72 69 63 2d 66 | 75 6e 63 74 69 6f 6e 2d |eneric-f|unction-|
|00000300| 6e 61 6d 65 73 20 28 28 | 63 20 73 74 61 6e 64 61 |names ((|c standa|
|00000310| 72 64 2d 63 6c 61 73 73 | 29 29 0d 20 20 28 72 65 |rd-class|)).  (re|
|00000320| 6d 6f 76 65 2d 64 75 70 | 6c 69 63 61 74 65 73 20 |move-dup|licates |
|00000330| 28 6d 61 70 63 61 72 20 | 23 27 6d 65 74 68 6f 64 |(mapcar |#'method|
|00000340| 2d 6e 61 6d 65 20 28 63 | 6c 61 73 73 2d 6d 65 74 |-name (c|lass-met|
|00000350| 68 6f 64 73 20 63 29 29 | 29 29 0d 0d 3b 3b 3b 20 |hods c))|))..;;; |
|00000360| 74 68 69 73 20 69 73 20 | 61 20 4d 4f 50 20 66 75 |this is |a MOP fu|
|00000370| 6e 63 74 69 6f 6e 20 28 | 6d 69 73 73 69 6e 67 20 |nction (|missing |
|00000380| 69 6e 20 4d 43 4c 20 72 | 69 67 68 74 20 6e 6f 77 |in MCL r|ight now|
|00000390| 29 0d 28 64 65 66 6d 65 | 74 68 6f 64 20 63 6c 61 |).(defme|thod cla|
|000003a0| 73 73 2d 64 69 72 65 63 | 74 2d 6d 65 74 68 6f 64 |ss-direc|t-method|
|000003b0| 73 20 28 28 63 20 63 6c | 61 73 73 29 29 0d 20 20 |s ((c cl|ass)).  |
|000003c0| 28 6d 61 70 61 70 70 65 | 6e 64 20 23 27 28 6c 61 |(mapappe|nd #'(la|
|000003d0| 6d 62 64 61 20 28 78 29 | 20 28 70 6f 70 75 6c 61 |mbda (x)| (popula|
|000003e0| 74 69 6f 6e 2d 64 61 74 | 61 20 78 29 29 0d 20 20 |tion-dat|a x)).  |
|000003f0| 20 20 20 20 20 20 20 20 | 20 20 20 28 25 63 6c 61 |        |   (%cla|
|00000400| 73 73 2d 64 69 72 65 63 | 74 2d 6d 65 74 68 6f 64 |ss-direc|t-method|
|00000410| 73 20 63 29 29 29 0d 0d | 28 64 65 66 75 6e 20 6d |s c)))..|(defun m|
|00000420| 61 70 61 70 70 65 6e 64 | 20 28 66 63 6e 20 6c 69 |apappend| (fcn li|
|00000430| 73 74 29 0d 20 20 22 41 | 70 70 6c 69 65 73 20 46 |st).  "A|pplies F|
|00000440| 43 4e 20 74 6f 20 65 76 | 65 72 79 20 65 6c 65 6d |CN to ev|ery elem|
|00000450| 65 6e 74 20 6f 66 20 4c | 49 53 54 2c 20 61 70 70 |ent of L|IST, app|
|00000460| 65 6e 64 69 6e 67 20 74 | 68 65 20 72 65 73 75 6c |ending t|he resul|
|00000470| 74 73 20 74 6f 67 65 74 | 68 65 72 2e 0d 4f 72 64 |ts toget|her..Ord|
|00000480| 65 72 20 69 73 20 6d 61 | 69 6e 74 61 69 6e 65 64 |er is ma|intained|
|00000490| 20 61 73 20 6f 6e 65 20 | 6d 69 67 68 74 20 65 78 | as one |might ex|
|000004a0| 70 65 63 74 2e 22 0d 20 | 20 28 6c 65 74 2a 20 28 |pect.". | (let* (|
|000004b0| 28 68 65 61 64 20 28 6c | 69 73 74 20 27 28 29 29 |(head (l|ist '())|
|000004c0| 29 20 28 74 61 69 6c 20 | 68 65 61 64 29 29 0d 20 |) (tail |head)). |
|000004d0| 20 20 20 28 64 6f 6c 69 | 73 74 20 28 65 6c 74 20 |   (doli|st (elt |
|000004e0| 6c 69 73 74 20 28 63 64 | 72 20 68 65 61 64 29 29 |list (cd|r head))|
|000004f0| 0d 20 20 20 20 20 20 28 | 64 6f 6c 69 73 74 20 28 |.      (|dolist (|
|00000500| 72 65 73 75 6c 74 2d 65 | 6c 74 20 28 66 75 6e 63 |result-e|lt (func|
|00000510| 61 6c 6c 20 66 63 6e 20 | 65 6c 74 29 29 0d 09 28 |all fcn |elt))..(|
|00000520| 73 65 74 66 20 28 63 64 | 72 20 74 61 69 6c 29 20 |setf (cd|r tail) |
|00000530| 28 6c 69 73 74 20 72 65 | 73 75 6c 74 2d 65 6c 74 |(list re|sult-elt|
|00000540| 29 29 0d 09 28 73 65 74 | 66 20 74 61 69 6c 20 28 |))..(set|f tail (|
|00000550| 63 64 72 20 74 61 69 6c | 29 29 29 29 29 29 0d 0d |cdr tail|))))))..|
|00000560| 28 64 65 66 6d 65 74 68 | 6f 64 20 63 6c 61 73 73 |(defmeth|od class|
|00000570| 2d 64 69 72 65 63 74 2d | 6d 65 74 68 6f 64 73 20 |-direct-|methods |
|00000580| 28 28 63 20 28 65 71 6c | 20 28 66 69 6e 64 2d 63 |((c (eql| (find-c|
|00000590| 6c 61 73 73 20 74 29 29 | 29 29 0d 20 20 6e 69 6c |lass t))|)).  nil|
|000005a0| 29 0d 0d 3b 3b 3b 20 47 | 65 74 20 74 68 65 20 76 |)..;;; G|et the v|
|000005b0| 61 6c 75 65 20 6f 66 20 | 61 20 63 6c 61 73 73 2d |alue of |a class-|
|000005c0| 61 6c 6c 6f 63 61 74 65 | 64 20 73 6c 6f 74 20 67 |allocate|d slot g|
|000005d0| 69 76 65 6e 20 74 68 65 | 20 63 6c 61 73 73 20 28 |iven the| class (|
|000005e0| 69 73 20 74 68 69 73 20 | 69 6e 20 74 68 65 20 4d |is this |in the M|
|000005f0| 4f 50 3f 20 20 49 74 20 | 6f 75 67 68 74 20 74 6f |OP?  It |ought to|
|00000600| 20 62 65 29 2e 0d 3b 3b | 3b 20 4e 6f 74 65 3a 20 | be)..;;|; Note: |
|00000610| 20 4d 43 4c 20 64 65 66 | 69 6e 65 73 20 73 65 74 | MCL def|ines set|
|00000620| 2d 63 6c 61 73 73 2d 73 | 6c 6f 74 2d 76 61 6c 75 |-class-s|lot-valu|
|00000630| 65 2c 20 74 68 69 73 20 | 69 73 20 61 20 73 69 6d |e, this |is a sim|
|00000640| 70 6c 65 20 6d 6f 64 69 | 66 69 63 61 74 69 6f 6e |ple modi|fication|
|00000650| 20 6f 66 20 69 74 0d 28 | 64 65 66 75 6e 20 63 6c | of it.(|defun cl|
|00000660| 61 73 73 2d 73 6c 6f 74 | 2d 76 61 6c 75 65 20 28 |ass-slot|-value (|
|00000670| 63 6c 61 73 73 20 6e 61 | 6d 65 29 0d 20 20 28 73 |class na|me).  (s|
|00000680| 65 74 71 20 63 6c 61 73 | 73 20 28 72 65 71 75 69 |etq clas|s (requi|
|00000690| 72 65 2d 74 79 70 65 20 | 63 6c 61 73 73 20 27 73 |re-type |class 's|
|000006a0| 74 64 2d 63 6c 61 73 73 | 29 29 0d 20 20 28 77 68 |td-class|)).  (wh|
|000006b0| 65 6e 20 28 6e 75 6c 6c | 20 28 25 63 6c 61 73 73 |en (null| (%class|
|000006c0| 2d 63 70 6c 20 63 6c 61 | 73 73 29 29 20 28 69 6e |-cpl cla|ss)) (in|
|000006d0| 69 74 69 61 6c 69 7a 65 | 2d 63 6c 61 73 73 20 63 |itialize|-class c|
|000006e0| 6c 61 73 73 29 29 0d 20 | 20 28 64 6f 6c 69 73 74 |lass)). | (dolist|
|000006f0| 20 28 73 6c 6f 74 64 20 | 28 25 63 6c 61 73 73 2d | (slotd |(%class-|
|00000700| 73 68 61 72 65 64 2d 73 | 6c 6f 74 64 73 20 63 6c |shared-s|lotds cl|
|00000710| 61 73 73 29 29 0d 20 20 | 20 20 28 77 68 65 6e 20 |ass)).  |  (when |
|00000720| 28 65 71 20 28 25 73 6c | 6f 74 64 2d 6e 61 6d 65 |(eq (%sl|otd-name|
|00000730| 20 73 6c 6f 74 64 29 20 | 6e 61 6d 65 29 0d 20 20 | slotd) |name).  |
|00000740| 20 20 20 20 28 72 65 74 | 75 72 6e 2d 66 72 6f 6d |    (ret|urn-from|
|00000750| 20 63 6c 61 73 73 2d 73 | 6c 6f 74 2d 76 61 6c 75 | class-s|lot-valu|
|00000760| 65 20 28 63 61 72 20 28 | 25 73 6c 6f 74 64 2d 76 |e (car (|%slotd-v|
|00000770| 61 6c 75 65 20 73 6c 6f | 74 64 29 29 29 29 29 0d |alue slo|td))))).|
|00000780| 20 20 28 73 6c 6f 74 2d | 6d 69 73 73 69 6e 67 20 |  (slot-|missing |
|00000790| 28 63 6c 61 73 73 2d 6f | 66 20 63 6c 61 73 73 29 |(class-o|f class)|
|000007a0| 20 63 6c 61 73 73 20 6e | 61 6d 65 20 27 73 6c 6f | class n|ame 'slo|
|000007b0| 74 2d 76 61 6c 75 65 29 | 29 0d 0d 28 64 65 66 73 |t-value)|)..(defs|
|000007c0| 65 74 66 20 63 6c 61 73 | 73 2d 73 6c 6f 74 2d 76 |etf clas|s-slot-v|
|000007d0| 61 6c 75 65 20 73 65 74 | 2d 63 6c 61 73 73 2d 73 |alue set|-class-s|
|000007e0| 6c 6f 74 2d 76 61 6c 75 | 65 29 0d 0d 00 00 00 00 |lot-valu|e)......|
|000007f0| 00 00 00 00 00 00 00 00 | 00 00 00 00 00 00 00 00 |........|........|
|00000800| 00 00 01 00 00 00 01 67 | 00 00 00 67 00 00 00 52 |.......g|...g...R|
|00000810| 20 20 20 20 20 20 20 20 | 20 20 20 28 6f 72 20 28 |        |   (or (|
|00000820| 6e 75 6c 6c 20 67 6b 65 | 79 73 29 0d 20 20 20 20 |null gke|ys).    |
|00000830| 0f 63 6c 6f 73 2d 68 61 | 63 6b 73 2e 6c 69 73 70 |.clos-ha|cks.lisp|
|00000840| 02 00 00 00 54 45 58 54 | 43 43 4c 32 01 00 00 50 |....TEXT|CCL2...P|
|00000850| 00 00 54 45 58 54 43 43 | 4c 32 01 00 00 50 00 00 |..TEXTCC|L2...P..|
|00000860| 00 00 00 00 00 00 00 00 | 00 00 00 00 00 00 00 00 |........|........|
|00000870| 00 00 a5 50 04 99 00 00 | 07 6c 00 00 01 b9 74 0d |...P....|.l....t.|
|00000880| 20 20 20 20 20 20 20 20 | 20 20 20 20 20 20 20 20 |        |        |
|00000890| 20 20 20 20 20 20 20 20 | 20 20 20 20 20 20 20 28 |        |       (|
|000008a0| 25 69 6e 6e 65 72 2d 6d | 65 74 68 6f 64 2d 66 75 |%inner-m|ethod-fu|
|000008b0| 6e 63 74 69 6f 6e 20 6d | 65 74 68 6f 64 29 29 29 |nction m|ethod)))|
|000008c0| 29 0d 20 20 20 20 20 20 | 20 20 20 20 20 20 20 20 |).      |        |
|000008d0| 20 20 20 20 20 28 64 6f | 76 65 63 74 6f 72 20 28 |     (do|vector (|
|000008e0| 6b 65 79 20 67 6b 65 79 | 73 20 74 29 0d 20 20 20 |key gkey|s t).   |
|000008f0| 20 20 20 20 20 20 20 20 | 20 20 20 20 20 20 20 20 |        |        |
|00000900| 00 00 00 0a 00 01 00 04 | 09 00 01 00 00 00 00 00 |........|........|
|00000910| 00 48 00 09 4d 6f 6e 61 | 63 6f 00 00 00 00 00 00 |.H..Mona|co......|
|00000920| 00 00 00 00 00 00 00 00 | 00 00 00 00 00 00 00 00 |........|........|
|00000930| 00 00 00 00 00 06 00 08 | 00 5e 01 53 02 c2 03 fe |........|.^.S....|
|00000940| 00 5e 01 53 02 c2 03 fe | 00 00 00 00 00 00 07 6c |.^.S....|.......l|
|00000950| 00 00 07 6c 00 00 00 00 | 01 00 00 00 00 09 7f ff |...l....|........|
|00000960| 06 4d 6f 6e 61 63 6f 00 | 00 01 00 00 00 01 67 00 |.Monaco.|......g.|
|00000970| 00 00 67 00 00 00 52 00 | 46 33 98 09 ec 00 00 00 |..g...R.|F3......|
|00000980| 1c 00 52 00 01 46 52 45 | 44 00 01 00 12 4d 50 53 |..R..FRE|D....MPS|
|00000990| 52 00 00 00 2a 00 02 ff | ff 00 00 00 00 00 00 00 |R...*...|........|
|000009a0| 00 00 03 ff ff 00 00 00 | 5a 00 00 00 00 03 ed ff |........|Z.......|
|000009b0| ff 00 00 00 0e 00 4a 4b | d8 00 00 00 00 00 00 00 |......JK|........|
|000009c0| 00 00 00 00 00 00 00 00 | 00 00 00 00 00 00 00 00 |........|........|
|000009d0| 00 00 00 00 00 00 00 00 | 00 00 00 00 00 00 00 00 |........|........|
|000009e0| 00 00 00 00 00 00 00 00 | 00 00 00 00 00 00 00 00 |........|........|
|000009f0| 00 00 00 00 00 00 00 00 | 00 00 00 00 00 00 00 00 |........|........|
+--------+-------------------------+-------------------------+--------+--------+